<%
Class clsFileUpload
  'Private Variables
  Private m_Accept
  Private m_SavePath
  'Propertys
  Public Property Let Accept(ByVal vNewValue)
    'ByVal vNewValue As String
    m_Accept = vNewValue
  End Property
  Public Property Get Accept()' As Boolean
    Accept = m_Accept
  End Property

  Public Property Let SavePath(ByVal vNewValue)
    'ByVal vNewValue As String
    m_SavePath = vNewValue
  End Property
  Public Property Get SavePath()' As Boolean
    SavePath = m_SavePath
  End Property

  'Class Init
  Private Sub Class_Initialize()
  End Sub

  Private Sub Class_Terminate()
  End Sub

  'Private Methods
  Private Sub m_CheckAndCreateFolder(ByVal FolderName)
    Dim fldr, fso
    fldr = Server.Mappath(FolderName)
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(fldr) Then
      fso.CreateFolder(fldr)
    End If
    Set fso = Nothing
  End Sub

  Private Function m_GetFileName(ByVal FileName)
    m_GetFileName = Mid(FileName, 1 + InStrRev(FileName, """"))
  End Function

  Public Function m_CreateNewFileName(ByVal FileName)
    Dim fso
    Dim msg
    Dim point, length, extension
    Set fso = Server.CreateObject("Scripting.FileSystemObject")
    
    point = InstrRev(FileName, ".")
    length = Len(FileName) 
    extension = Right(FileName, length - point + 1)
    If fso.FileExists(FileName) Then 
      msg = True
      Do While msg
        FileName = Replace(FileName, extension, "_" & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & extension)
        If Not fso.FileExists(FileName) Then
          m_CreateNewFileName = FileName
          msg = False 
        End If
      Loop
    End If
     m_CreateNewFileName = FileName
    Set fso = Nothing 
  End Function

  Function m_CheckFileExt(FileName, ExtName) '文件名,允许上传文件类型 
    FileType = ExtName
    FileType = Split(FileType, ",")
    For i = 0 To Ubound(FileType)
      If LCase(Right(FileName, 3)) = LCase(FileType(i)) then
        m_CheckFileExt = True
        Exit Function
      Else
        m_CheckFileExt = False
      End if
    Next
  End Function
  'Public Method

  Public Function Process(ByRef Req, ByVal FileName)
    Dim updateSize
    Dim uploadStream_c, FormStream_h
    Dim mFormBins
    Dim k, l

    'adjust folder path
    If Right(m_SavePath,1) <> "/" Then m_SavePath = m_SavePath & "/" '在目录后加(/)
    'creat folder if it does not exists
    m_CheckAndCreateFolder m_SavePath
    updateSize = Req.TotalBytes
    if updateSize > 0 Then
      Set uploadStream_c = Server.CreateObject("ADODB.Stream") '新建一个数据流对象
      uploadStream_c.Type = 1 '[类型为二进制]只有在当前位置位于 Stream 的开始处（Position 为 0）时，Type 属性才为读/写；位于其他位置时均为只读。
      uploadStream_c.Open  '打开流
      uploadStream_c.Write Request.BinaryRead(updateSize) '将从表单反馈的二进制数据写入updateSize个字节到流
      uploadStream_c.Position = 0 
      
      mFormBins = uploadStream_c.Read '将所有二进制读取到mFormBins
      CrLf_e = ChrB(13) & ChrB(10) '回车符
      FormStart_f = InStrB(mFormBins, CrLf_e) '在所有数据中找到回车符的位置，作为数据段开始
      FormEnd_g = InStrB(FormStart_f + 1, mFormBins, CrLf_e) '在数据中，找第二个回车符位置，作为结尾

      Set FormStream_h = Server.CreateObject("ADODB.Stream") '建立第三个Adodb.Stream对象
      FormStream_h.Type = 1 
      FormStream_h.Open 
      uploadStream_c.Position = FormStart_f + 1 '设定读取开始位置
      uploadStream_c.CopyTo FormStream_h,FormEnd_g - FormStart_f - 3 '将数据内容复制到第三个Stream中
      FormStream_h.Position = 0 
      FormStream_h.Type = 2 
      FormStream_h.CharSet = "UTF-8" 
      FormStreamText_i = FormStream_h.Readtext '从第二个Stream头部读取数据
      FormStream_h.Close 

      If FileName = "" Then
        'Get FileName From ref only if FileName is empty in function call
        FileName = Mid(FormStreamText_i, InstrRev(FormStreamText_i, "\") + 1, FormEnd_g)
      End If
      If m_CheckFileExt(m_GetFileName(FileName), m_Accept) Then 
        SaveFile = Server.MapPath(m_SavePath & m_GetFileName(FileName)) 
        If Err Then 
          Response.Write "error:Mappath"
          Err.Clear 
        Else 
          SaveFile = m_CreateNewFileName(SaveFile) 

          k = InstrB(mFormBins, CrLf_e & CrLf_e) + 4 
          l = InstrB(k + 1, mFormBins, leftB(mFormBins, FormStart_f - 1)) - k - 2 
          FormStream_h.Type = 1 
          FormStream_h.Open 
          uploadStream_c.Position = k - 1 
          uploadStream_c.CopyTo FormStream_h, l 
          FormStream_h.SaveToFile SaveFile, 2 
          
          SaveFileName = Mid(SaveFile,InstrRev(SaveFile, "\") + 1) 

          '--------------插入完成------------  
          Response.write "done" 
        End If 
      Else 
        Response.Write "error-ext" 
      End If
    Else
      Process = "null"
    End if
  End Function
End Class
%>